home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 002a / gravwar2.zip / GRAVWAR2.PAS < prev   
Pascal/Delphi Source File  |  1990-09-16  |  35KB  |  931 lines
  1. {$A+,B-,D-,E+,F-,I+,L-,N+,O-,R-,S+,V+}
  2. {$M 16384,0,655360}
  3.  
  4. Program GravityWars;
  5. { by Sohrab Ismail-Beigi     Completed 4/23/89
  6.      SYSOP of The 3D Graphics BBS
  7.      300/1200/2400 baud, N-8-1 Full duplex
  8.      (201) 444-4154}
  9.  
  10. {Turbo Pascal 5.0 source code.  Requires VGA 640x480x16 display.}
  11. {Note: pix=pixels in the comments}
  12.  
  13. (****************************************************************)
  14. (*        UPDATED  16 SEP 90    v2.0?                           *)
  15. (*        by Arthur R. Hicken                                   *)
  16. (*        SysOp of The Midnight BBS                             *)
  17. (*        300/1200/2400 N,8,1                                   *)
  18. (*        708-972-1630  Midnight to 7am Central Time            *)
  19. (*        Every night except Friday (Fridays are OFFLINE)       *)
  20. (*        Prodigy: CVTS94A                                      *)
  21. (*        GEnie: A.HICKEN                                       *)
  22. (*                                                              *)
  23. (*        CHANGES MADE:                                         *)
  24. (*        Checks for VGA Graphics                               *)
  25. (*        Graph Driver and TypeFont Linked into program file    *)
  26. (*        Updated compilation for TP5.0                         *)
  27. (*        Colored Stars (I hate White!)                         *)
  28. (*        Different Colored Tracks for Different Ships          *)
  29. (*        (makes it easier to tell them apart)                  *)
  30. (****************************************************************)
  31.  
  32.  
  33. (******************* IDEAS FOR THE FUTURE ***********************)
  34. (*    include rules in final copy                               *)
  35. (*    error messages for incorrect input                        *)
  36. (*    Different colors for menus                                *)
  37. (*    Does this support Math Co-Processors?                     *)
  38. (*    EGA 640x350 version                                       *)
  39. (*    MCGA Version  320x200x256                                 *)
  40. (*    Make twinkling Stars                                      *)
  41. (****************************************************************)
  42.  
  43. Uses Crt,Graph,Drivers,Fonts;
  44.  
  45. Type
  46.     spacecraft=Record                       {used for ships and pointer}
  47.                  coffx,coffy,r : longint;   {center offsets and radius in pix}
  48.                  imagex,imagey : longint;   {upper left of image}
  49.                  imagepointr   : pointer;   {pointer to image data}
  50.                  imagesize     : word;      {size in bytes}
  51.                end;
  52.     planettype=Record
  53.                  cx,cy,r : longint;         {planet center and radius}
  54.                  d,GM    : real;            {density and G*M product}
  55.                end;
  56.  
  57. Const
  58.      color : array[1..3] of byte=(Red,Green,LightBlue); {colors for planets}
  59.      G=0.1;                                             {gravity constant}
  60.      bhr=15;                                            {black hole radius}
  61.      Esc=#27;                                           {ASCII for Esc}
  62.      Return=#13;                                        { "     "  RETURN}
  63.  
  64. Var
  65.   ship      : array[1..2] of spacecraft;    {2 ships}
  66.   tp,pointr : spacecraft;                   {tp is temporary, 1 pointer}
  67.   pl        : array[1..9] of planettype;    {the 9 planets}
  68.   screen    : Record                        {the game area}
  69.                 sx,ex,sy,ey,cx,cy,lx,ly : longint; {start x/y, end x/y, center}
  70.               end;                                 {x/y, length x/y}
  71.   np,GraphDriver,GraphMode : integer;              {# of planets}
  72.   criticaldist : real;                             {for escape velocity calc}
  73.   playsong  : boolean;                             {play the songs?}
  74.  
  75. Procedure Init;              {initialize everything}
  76.  
  77. procedure Abort(Msg : string);
  78. begin
  79.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  80.   Halt(1);
  81. end;
  82.  
  83. begin
  84.   { Register VGA driver }
  85.   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
  86.     Abort('EGA/VGA');
  87.  
  88.   { Register SANS font }
  89.   if RegisterBGIfont(@SansSerifFontProc) < 0 then
  90.     Abort('SansSerif');
  91.  
  92.   SetGraphBufSize(10);       {make the buffer big enough for big floodfills}
  93.   DetectGraph(GraphDriver,GraphMode);
  94.   if GraphDriver <> VGA then
  95.     begin
  96.       Writeln('GravWars requires VGA');
  97.       Halt(2);
  98.     end;
  99.  
  100.   GraphDriver:=VGA; GraphMode:=VGAHi;
  101.   InitGraph(GraphDriver,GraphMode,'');
  102.   if GraphResult <> grOk then             { any errors? }
  103.   begin
  104.     Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
  105.     Halt(3);
  106.   end;
  107.   SetColor(LightGray); SetFillStyle(SolidFill,LightGray);      {Hull of ships}
  108.   Circle(100,100,9); FloodFill(100,100,LightGray); Bar(77,98,100,102);
  109.   MoveTo(82,98); LineRel(-3,-8); LineRel(-13,0); LineRel(0,-3); LineRel(24,0);
  110.   LineRel(0,3); LineRel(-7,0); LineRel(3,8); FloodFill(83,97,LightGray);
  111.   MoveTo(82,101); LineRel(-3,8); LineRel(-13,0); LineRel(0,3); LineRel(24,0);
  112.   LineRel(0,-3); LineRel(-7,0); LineRel(3,-8); FloodFill(83,103,LightGray);
  113.   MoveTo(200,200); LineRel(5,-5); LineRel(5,5); LineRel(10,0); LineRel(5,-8);
  114.   LineRel(15,0); LineRel(-6,9); LineRel(6,9); LineRel(-15,0); LineRel(-5,-7);
  115.   LineRel(-10,0); LineRel(-5,5); LineRel(-6,-7); LineRel(2,-2);
  116.   FloodFill(201,201,LightGray);
  117.   SetColor(LightRed); SetFillStyle(SolidFill,LightRed); {Red lights on ships}
  118.   Circle(100,100,2); FloodFill(100,100,LightRed);
  119.   Bar(89,87,91,90); Bar(89,109,91,112);
  120.   Bar(224,200,226,203); Bar(240,192,242,194); Bar(240,208,242,210);
  121.   SetColor(Yellow); MoveTo(0,0); LineRel(0,10); MoveTo(0,0); LineRel(10,0);
  122.   MoveTo(0,0); LineRel(15,15);   {pointer}
  123.   tp.imagesize:=ImageSize(0,0,16,16);     {kludge to subdue compiler bug}
  124.   GetMem(tp.imagepointr,tp.imagesize);
  125.   GetImage(0,0,16,16,tp.imagepointr^);
  126.   pointr.imagesize:=ImageSize(0,0,16,16);
  127.   GetMem(pointr.imagepointr,pointr.imagesize);
  128.   GetImage(0,0,16,16,pointr.imagepointr^);           {get pointer}
  129.   pointr.coffx:=7; pointr.coffy:=7; pointr.r:=9;
  130.   ship[1].imagesize:=ImageSize(66,87,110,113);
  131.   GetMem(ship[1].imagepointr,ship[1].imagesize);
  132.   GetImage(66,87,110,113,ship[1].imagepointr^);      {enterprise}
  133.   ship[1].coffx:=22; ship[1].coffy:=13; ship[1].r:=26;
  134.   ship[2].imagesize:=ImageSize(199,192,242,210);
  135.   GetMem(ship[2].imagepointr,ship[2].imagesize);
  136.   GetImage(199,192,242,210,ship[2].imagepointr^);     {klingon}
  137.   ship[2].coffx:=21; ship[2].coffy:=9; ship[2].r:=23;
  138.   ClearDevice;
  139.   screen.sx:=1; screen.ex:=638; screen.sy:=33; screen.ey:=478;
  140.   screen.cx:=(screen.sx+screen.ex) div 2;                 {initialize screen}
  141.   screen.cy:=(screen.sy+screen.ey) div 2;                            {bounds}
  142.   screen.lx:=screen.ex-screen.sx+1;
  143.   screen.ly:=screen.ey-screen.sy+1;
  144.   criticaldist:=2.0*sqrt(sqr(screen.lx)+sqr(screen.ly)); {critical distance}
  145.   playsong:=true;                                    {for escape vel. calc}
  146. end;
  147.  
  148. Procedure Finish;   {free memory and end}
  149. begin
  150.   FreeMem(ship[1].imagepointr,ship[1].imagesize);
  151.   FreeMem(ship[2].imagepointr,ship[2].imagesize);
  152.   FreeMem(pointr.imagepointr,pointr.imagesize);
  153.   FreeMem(tp.imagepointr,tp.imagesize);
  154.   CloseGraph;
  155. end;
  156.  
  157. Function InBounds(cx,cy,r:longint):boolean; {is the point with radius}
  158. begin                                       {completely in screen bounds?}
  159.    InBounds:=true;
  160.    if r<>0 then
  161.      if (cx-r<=screen.sx) or (cx+r>=screen.ex) or
  162.         (cy-r<=screen.sy) or (cy+r>=screen.ey) then
  163.           InBounds:=false
  164.    else
  165.      if (cx-bhr<=screen.sx) or (cx+bhr>=screen.ex) or
  166.         (cy-bhr<=screen.sy) or (cy+bhr>=screen.ey) then
  167.           InBounds:=false;
  168. end;
  169.  
  170. Procedure RandomSetup;   {make a random setup}
  171. var i,j : integer;
  172.     a,b : longint;
  173.     ok  : boolean;
  174. begin
  175.   Randomize;
  176.   np:=Random(9)+1;   {random # of planets 1-9}
  177.   for i:=1 to np do  {pick planet positions}
  178.     Repeat
  179.       ok:=true;
  180.       pl[i].cx:=Random(screen.lx)+screen.sx;
  181.       pl[i].cy:=Random(screen.ly)+screen.sy;
  182.       pl[i].d:=(Random(3)+2)/2.0;
  183.       pl[i].r:=0;
  184.       if Random>0.05 then pl[i].r:=Random(70)+20; {5% chance of blackhole}
  185.       if pl[i].r<>0 then
  186.         pl[i].GM:=G*2*pi*sqr(pl[i].r)*pl[i].d
  187.       else
  188.         pl[i].GM:=G*2*pi*sqr(30)*1.0;
  189.       ok:=InBounds(pl[i].cx,pl[i].cy,pl[i].r);
  190.       if (i>1) and (ok) then          {any collisions with existing planets?}
  191.         for j:=1 to i-1 do
  192.           begin
  193.           if sqrt(sqr(pl[i].cx-pl[j].cx)+sqr(pl[i].cy-pl[j].cy))<=
  194.             pl[i].r+pl[j].r+2*bhr then
  195.                ok:=false;
  196.           end;
  197.     Until ok;
  198.   for i:=1 to 2 do   {pick ship positions}
  199.     Repeat
  200.       ok:=true;
  201.       ship[i].imagex:=Random(screen.lx div 2)+screen.sx; {enterprise to the}
  202.       if i=2 then ship[2].imagex:=ship[i].imagex+screen.lx div 2; {left and}
  203.       ship[i].imagey:=Random(screen.ly)+screen.sy;      {klingon to the right}
  204.       a:=ship[i].imagex+ship[i].coffx; b:=ship[i].imagey+ship[i].coffy;
  205.       ok:=InBounds(a,b,ship[i].r);
  206.       for j:=1 to np do           {any collisions with planets?}
  207.         if sqrt(sqr(a-pl[j].cx)+sqr(b-pl[j].cy))<=pl[j].r+ship[i].r+bhr then
  208.            ok:=false;
  209.     Until ok;
  210. end;
  211.  
  212. Procedure DrawSetup;  {draw current setup}
  213. var i,j : integer;
  214. begin
  215.   ClearDevice;
  216.   SetColor(White);
  217.   Rectangle(screen.sx-1,screen.sy-1,screen.ex-1,screen.ey-1); {game box}
  218.   for i:=1 to 2000 do             {2000 random stars}
  219.     PutPixel(Random(screen.lx)+screen.sx,Random(screen.ly)+screen.sy,Random(15));
  220.   for i:=1 to 2 do  {2 ships}
  221.     PutImage(ship[i].imagex,ship[i].imagey,ship[i].imagepointr^,NormalPut);
  222.   for i:=1 to np do  {np planets}
  223.     if pl[i].r>0 then   {normal}
  224.       begin
  225.         SetColor(color[trunc(pl[i].d*2-1)]);
  226.         Circle(pl[i].cx,pl[i].cy,pl[i].r);
  227.         SetFillStyle(SolidFill,color[trunc(pl[i].d*2-1)]);
  228.         FloodFill(pl[i].cx,pl[i].cy,color[trunc(pl[i].d*2-1)]);
  229.       end
  230.     else               {black hole}
  231.       begin
  232.         SetColor(Black);
  233.         for j:=0 to bhr do
  234.           Circle(pl[i].cx,pl[i].cy,j);
  235.       end;
  236. end;
  237.  
  238. Procedure ClearDialogBox;  {clear text message area}
  239. begin
  240.   SetFillStyle(SolidFill,Black);
  241.   Bar(0,0,screen.ex-1,screen.sy-2);
  242. end;
  243.  
  244. Function GetString:string;  {get a string until RETURN is pressed}
  245. var s : string;
  246.     c : char;
  247. begin
  248.   s:='';
  249.   Repeat
  250.     c:=ReadKey;
  251.     if (c=chr(8)) and (length(s)>0) then          {backspace key}
  252.         begin
  253.           delete(s,length(s),1);
  254.           MoveRel(-8,0);                          {delete last char}
  255.           SetFillStyle(SolidFill,Black);
  256.           Bar(GetX,GetY,GetX+8,GetY+8);
  257.         end
  258.     else if c<>Return then
  259.       begin
  260.         s:=concat(s,c);                           {get and draw char}
  261.         SetColor(LightGray);
  262.         OutText(c);
  263.       end;
  264.   Until c=Return;
  265.   GetString:=s;
  266. end;
  267.  
  268. Procedure PlayGame;
  269. Const number_of_explosion_dots=20;   {# dots for explosion with planet surface}
  270. Var vx,vy,vc,x,y,dt,ax,ay,dx,dy,dr,k : real;
  271.     v0,angle : array[1..2] of real;
  272.     s : string;
  273.     ch : char;
  274.     i,event,player,winner : integer;
  275.     ok,donecritical,offscreen : boolean;
  276.     buffer : array[1..number_of_explosion_dots] of Record  {for explosion}
  277.                                                      x,y,color : integer;
  278.                                                    end;
  279. begin
  280.   v0[1]:=0; v0[2]:=0; angle[1]:=0; angle[2]:=0;
  281.   player:=1;
  282.   donecritical:=false;
  283.   Repeat                               {infinite loop}
  284.     ClearDialogBox;
  285.     SetColor(LightGray);
  286.     str(player,s);
  287.     s:=concat('Player ',s);        {player #}
  288.     OutTextXY(0,0,s);
  289.     Repeat                         {get angle}
  290.       MoveTo(0,10);
  291.       str(angle[player]:3:5,s);
  292.       s:=concat('Angle: [',s,']: ');
  293.       OutText(s);
  294.       s:=GetString;
  295.       if (s[1]='Q') or (s[1]='q') then exit;
  296.       i:=0;
  297.       if s<>'' then Val(s,angle[player],i);
  298.       SetFillStyle(SolidFill,Black);
  299.       ok:=(i=0) and (angle[player]>=0.0) and (angle[player]<=360);
  300.       if not ok then Bar(0,0,screen.ex-1,8);
  301.     Until ok;
  302.     Repeat                        {get initial velocity}
  303.       MoveTo(0,20);
  304.       str(v0[player]:2:5,s);
  305.       s:=concat('Initial Velocity: [',s,']: ');
  306.       OutText(s);
  307.       s:=GetString;
  308.       if (s[1]='Q') or (s[1]='q') then exit;
  309.       i:=0;
  310.       if s<>'' then Val(s,v0[player],i);
  311.       SetFillStyle(SolidFill,Black);
  312.       ok:=(i=0) and (v0[player]>=0.0) and (v0[player]<=10.0);
  313.       if not ok then Bar(0,10,screen.ex-1,18);
  314.     Until ok;
  315.     k:=pi*angle[player]/180.0;   {angle in radians}
  316.     vx:=v0[player]*cos(k);
  317.     vy:=-v0[player]*sin(k);
  318.     x:=ship[player].imagex+ship[player].coffx+ship[player].r*cos(k);
  319.     y:=ship[player].imagey+ship[player].coffy-ship[player].r*sin(k);
  320.     ClearDialogBox;
  321.     MoveTo(round(x),round(y));
  322.     if player = 1 then SetColor(LightRed)
  323.     else if player = 2 then SetColor(LightGreen);
  324.     offscreen:=false;
  325.     Repeat                       {calculate and draw trajectory}
  326.       dt:=0.25;                  {time interval [vel. is in pix/time]}
  327.       x:=x+vx*dt; y:=y+vy*dt;
  328.       ax:=0; ay:=0;
  329.       for i:=1 to np do          {calc accel. due to gravity}
  330.         begin
  331.           dx:=x-pl[i].cx; dy:=y-pl[i].cy; dr:=sqrt(sqr(dx)+sqr(dy));
  332.           k:=1/(sqr(dr)*dr);
  333.           if pl[i].r<>0 then       {normal}
  334.             begin
  335.               ax:=ax-pl[i].GM*dx*k;
  336.               ay:=ay-pl[i].GM*dy*k
  337.             end
  338.           else                     {black hole}
  339.             begin
  340.               ax:=ax-pl[i].GM*dx*(k+sqr(k*dr));
  341.               ay:=ay-pl[i].GM*dy*(k+sqr(k*dr));
  342.             end;
  343.         end;
  344.       vx:=vx+ax*dt; vy:=vy+ay*dt;
  345.       event:=0;
  346.       if keypressed then
  347.         event:=1
  348.       else if (x>=screen.sx) and (x<=screen.ex) and        {in screen bounds?}
  349.               (y>=screen.sy) and (y<=screen.ey) then
  350.          begin
  351.            donecritical:=false;
  352.            i:=GetPixel(round(x),round(y));
  353.            if (i=color[1]) or (i=color[2]) or (i=color[3]) or
  354.               (i=LightRed) or (i=LightGray) then event:=2
  355.            else
  356.              if offscreen then
  357.                MoveTo(round(x),round(y))
  358.              else
  359.                LineTo(round(x),round(y));
  360.            offscreen:=false;
  361.          end                                               {off screen}
  362.       else if not donecritical then
  363.         begin
  364.           offscreen:=true;               {offscreen and critical distance}
  365.           dx:=x-screen.cx; dy:=y-screen.cy; dr:=sqrt(sqr(dx)+sqr(dy));
  366.           if dr>=criticaldist then
  367.             begin
  368.               vc:=(dx*vx+dy*vy)/dr;
  369.               k:=0; for i:=1 to np do k:=k+pl[i].GM;
  370.               if 0.5*sqr(vc)>=k/dr then     {do we have escape velocity?}
  371.                 event:=3;
  372.             end;
  373.         end;
  374.     Until event<>0;
  375.     if event=1 then          {a key was pressed for a break}
  376.       begin
  377.         ClearDialogBox;
  378.         ch:=ReadKey; {one already in buffer}
  379.         SetColor(LightGray);
  380.         OutTextXY(0,0,'Break... Esc to break, any other key to continue');
  381.         ch:=ReadKey;
  382.         if ch=Esc then exit;
  383.       end
  384.     else if event=3 then       {missile escaped the universe}
  385.       begin
  386.         ClearDialogBox;
  387.         SetColor(LightGray);
  388.         OutTextXY(0,0,'Missile left the galaxy...');
  389.         delay(2000);
  390.       end
  391.     else           {event=2}   {hit something}
  392.       begin
  393.         if (i=color[1]) or (i=color[2]) or (i=color[3]) then  {hit a planet}
  394.           begin
  395.             for i:=1 to number_of_explosion_dots do     {draw explosion}
  396.               begin
  397.                 buffer[i].x:=trunc(x+20*(Random-0.5));
  398.                 buffer[i].y:=trunc(y+20*(Random-0.5));
  399.                 buffer[i].color:=GetPixel(buffer[i].x,buffer[i].y);
  400.                 PutPixel(buffer[i].x,buffer[i].y,LightRed);
  401.                 delay(25);
  402.               end;
  403.             delay(1000);
  404.             for i:=1 to number_of_explosion_dots do     {erase explosion}
  405.               PutPixel(buffer[i].x,buffer[i].y,buffer[i].color);
  406.           end
  407.         else    {hit a ship!}
  408.           begin
  409.             if sqrt(sqr(x-ship[1].imagex-ship[1].coffx)+ {which one won?}
  410.                     sqr(y-ship[1].imagey-ship[1].coffy))<=ship[1].r+5 then
  411.                       winner:=2
  412.             else winner:=1;
  413.             for event:=1 to 100 do          {flash the screen}
  414.               SetPalette(Black,Random(16));
  415.             SetPalette(Black,Black);
  416.             for i:=1 to 1000 do    {put some white and red points}
  417.               begin
  418.                 k:=Random*2*pi;
  419.                 event:=Random(3);
  420.                 if event=0 then
  421.                   PutPixel(trunc(x+30*Random*cos(k)),trunc(y+30*Random*sin(k)),Black)
  422.                 else if event=1 then
  423.                   PutPixel(trunc(x+30*Random*cos(k)),trunc(y+30*Random*sin(k)),Red)
  424.                 else
  425.                   PutPixel(trunc(x+20*Random*cos(k)),trunc(y+20*Random*sin(k)),White);
  426.               end;
  427.             ClearDialogBox;
  428.             SetColor(LightGray);
  429.             str(winner,s);
  430.             s:=concat('Player ',s,' wins!!!');    {announce}
  431.             OutTextXY(0,0,s);
  432.             if playsong then                      {play a tune}
  433.               begin
  434.                 Sound(440); delay(150);
  435.                 Nosound; delay(50);
  436.                 Sound(440); delay(150);
  437.                 Sound(554); delay(150);
  438.                 Sound(659); delay(350);
  439.                 Sound(554); delay(150);
  440.                 Sound(659); delay(450);
  441.                 Nosound; delay(500);
  442.                 Sound(880); delay(800);
  443.                 Nosound;
  444.               end;
  445.             delay(3000);
  446.             exit;
  447.           end;
  448.       end; {if event=3}
  449.     Inc(player); if player=3 then player:=1;    {next player}
  450.   Until true=false; {infinite loop}
  451. end;
  452.  
  453. Procedure PlayingtheGame;     {playing the game menu}
  454. var option : char;
  455. begin
  456.   Repeat
  457.     ClearDialogBox;
  458.     SetColor(LightGray);
  459.     OutTextXY(0,0,'1. Random setup   2. Play game    Esc quits menu');
  460.     OutTextXY(0,10,'Option: ');
  461.     option:=ReadKey;
  462.     Case option of
  463.       '1' : begin
  464.               ClearDialogBox;
  465.               RandomSetup;
  466.               DrawSetup;
  467.             end;
  468.       '2' : PlayGame;
  469.     end;
  470.   Until option=Esc;
  471. end;
  472.  
  473. Procedure Options;   {options menu}
  474. var option : char;
  475. begin
  476.   Repeat
  477.     ClearDialogBox;
  478.     SetColor(LightGray);
  479.     OutTextXY(0,0,'1. Redraw screen   2. Sound on/off     Esc quits menu');
  480.     OutTextXY(0,10,'Option: ');
  481.     option:=ReadKey;
  482.     Case option of
  483.       '1' : DrawSetUp;
  484.       '2' : playsong:=not playsong;
  485.     end;
  486.   Until option=Esc;
  487. end;
  488.  
  489. Procedure InterpKey(c:char; var x,y,coffx,coffy,r:longint;
  490.                             var jump:integer; var moveit:boolean);
  491. begin              {interprets keys for movement of pointer, mainly to save}
  492.   Case c of                {space due to shared code in many Change routines}
  493.     '+' : if jump<49 then Inc(jump,2);
  494.     '-' : if jump>2 then Dec(jump,2);
  495.     '8' : begin                              {up}
  496.             Dec(y,jump);
  497.             if InBounds(x+coffx,y+coffy,r) then
  498.               moveit:=true
  499.             else
  500.               Inc(y,jump);
  501.           end;
  502.     '2' : begin                              {down}
  503.             Inc(y,jump);
  504.             if InBounds(x+coffx,y+coffy,r) then
  505.               moveit:=true
  506.             else
  507.               Dec(y,jump);
  508.           end;
  509.     '4' : begin                              {left}
  510.             Dec(x,jump);
  511.             if InBounds(x+coffx,y+coffy,r) then
  512.               moveit:=true
  513.             else
  514.               Inc(x,jump);
  515.           end;
  516.     '6' : begin                              {right}
  517.             Inc(x,jump);
  518.             if InBounds(x+coffx,y+coffy,r) then
  519.               moveit:=true
  520.             else
  521.               Dec(x,jump);
  522.           end;
  523.   end; {case c of}
  524. end;
  525.  
  526. Procedure MoveShip;    {move a given ship to a new legal position}
  527. var c : char;
  528.     s,jump,j : integer;
  529.     x,y,xold,yold,a,b : longint;
  530.     legal,moveit : boolean;
  531. begin
  532.   ClearDialogBox;
  533.   SetColor(LightGray);
  534.   OutTextXY(0, 0,'Ships:  1. Enterprise   2. Klingon    Esc aborts');
  535.   OutTextXY(0,10,'Which ship? ');     {get the proper ship}
  536.   Repeat
  537.     c:=ReadKey;
  538.   Until (c='1') or (c='2') or (c=Esc);
  539.   if c=Esc then exit;
  540.   if c='1' then s:=1 else s:=2;
  541.   ClearDialogBox;
  542.   OutTextXY(0, 0,'Use cursors to move ship. (Num Lock on)   Esc aborts');
  543.   OutTextXY(0,10,'Enter to place, + and - to change size of jumps.');
  544.   jump:=30;
  545.   x:=ship[s].imagex; y:=ship[s].imagey;
  546.   Repeat    {loop until Esc or somewhere legal}
  547.     Repeat    {loop until Esc or RETURN}
  548.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  549.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  550.       moveit:=false; xold:=x; yold:=y;
  551.       InterpKey(c,x,y,ship[s].coffx,ship[s].coffy,ship[s].r,jump,moveit);
  552.       if moveit then  {if can move the image,}
  553.         begin
  554.           PutImage(xold,yold,ship[s].imagepointr^,XORPut); {erase old}
  555.           PutImage(x,y,ship[s].imagepointr^,XORPut);       {draw new}
  556.           moveit:=false;
  557.         end;
  558.     Until (c=Return) or (c=Esc);
  559.     if c=Esc then                     {abort}
  560.       begin
  561.         PutImage(x,y,ship[s].imagepointr^,XORPut);
  562.         PutImage(ship[s].imagex,ship[s].imagey,ship[s].imagepointr^,NormalPut);
  563.         exit;
  564.       end;
  565.     a:=x+ship[s].coffx; b:=y+ship[s].coffy;
  566.     legal:=InBounds(a,b,ship[s].r);     {in bounds?}
  567.     for j:=1 to np do                   {in collision with any planets?}
  568.       if sqrt(sqr(a-pl[j].cx)+sqr(b-pl[j].cy))<=pl[j].r+ship[s].r+bhr then
  569.          legal:=false;
  570.     if not legal then                   {oops! not legal!}
  571.       begin
  572.         SetPalette(Black,White);
  573.         SetFillStyle(SolidFill,Black);
  574.         Bar(0,20,screen.ex,screen.sy-2);
  575.         delay(100);
  576.         SetPalette(Black,Black);
  577.         SetColor(LightGray);
  578.         OutTextXY(0,20,'Illegal ship position!');
  579.       end;
  580.   Until legal;
  581.   ship[s].imagex:=x; ship[s].imagey:=y;    {ok, place it there}
  582. end;
  583.  
  584. Procedure MovePlanet;   {move a planet}
  585. var c : char;
  586.     i,p,jump : integer;
  587.     x,y,xold,yold,minr,t,cxorig,cyorig : longint;
  588.     moveit,legal : boolean;
  589. begin
  590.   ClearDialogBox;
  591.   if np=0 then         {no planets!}
  592.     begin
  593.       OutTextXY(0,0,'No planets to move!');
  594.       delay(2000);
  595.       exit;
  596.     end;
  597.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  598.   OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
  599.   jump:=30;
  600.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  601.   Repeat    {loop until Esc or RETURN}
  602.     Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  603.                              (c='+') or (c='-') or (c=Return) or (c=Esc);
  604.     moveit:=false; xold:=x; yold:=y;
  605.     InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  606.     if moveit then
  607.       begin
  608.         PutImage(xold,yold,pointr.imagepointr^,XORPut);
  609.         PutImage(x,y,pointr.imagepointr^,XORPut);
  610.         moveit:=false;
  611.       end;
  612.   Until (c=Return) or (c=Esc);
  613.   PutImage(x,y,pointr.imagepointr^,XORPut);   {erase pointer}
  614.   if c=Esc then exit;
  615.   p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
  616.   for i:=1 to np do   {find the closest planet/black hole}
  617.     begin
  618.       t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
  619.       if t<minr then begin minr:=t; p:=i; end;
  620.     end;
  621.   SetColor(LightGreen);                      {clear it out}
  622.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  623.   SetFillStyle(SolidFill,Black);
  624.   FloodFill(pl[p].cx,pl[p].cy,LightGreen);
  625.   SetColor(Black);
  626.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  627.   ClearDialogBox;
  628.   SetColor(LightGray);
  629.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  630.   OutTextXY(0,10,'Enter to place planet center, + - change size of jumps.');
  631.   jump:=30;
  632.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  633.   cxorig:=pl[p].cx; cyorig:=pl[p].cy;   {save them as they may change later}
  634.   Repeat    {loop until Esc or legal position}
  635.     Repeat
  636.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  637.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  638.       moveit:=false; xold:=x; yold:=y;
  639.       InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  640.       if moveit then
  641.         begin
  642.           PutImage(xold,yold,pointr.imagepointr^,XORPut);
  643.           PutImage(x,y,pointr.imagepointr^,XORPut);
  644.           moveit:=false;
  645.         end;
  646.     Until (c=Return) or (c=Esc);
  647.     legal:=true;
  648.     if c<>Esc then    {ok, RETURN pressed}
  649.       begin
  650.         pl[p].cx:=-1000; pl[p].cy:=-1000;  {so it won't collide with itself!}
  651.         for i:=1 to np do   {any collisions with other planets?}
  652.           if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[i].r+pl[p].r+2*bhr then
  653.             legal:=false;
  654.         for i:=1 to 2 do    {any collisions with other ships?}
  655.           if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
  656.                   sqr(y-ship[i].imagey-ship[i].coffy))<=pl[p].r+ship[i].r+bhr
  657.              then legal:=false;
  658.       end;
  659.     if not legal then      {oops!}
  660.       begin
  661.         SetPalette(Black,White);
  662.         SetFillStyle(SolidFill,Black);
  663.         Bar(0,20,screen.ex,screen.sy-2);
  664.         delay(100);
  665.         SetPalette(Black,Black);
  666.         SetColor(LightGray);
  667.         OutTextXY(0,20,'Illegal planet position!');
  668.       end;
  669.   Until legal;
  670.   pl[p].cx:=x; pl[p].cy:=y; {put it there}
  671.   if c=Esc then             {abort and restore}
  672.     begin
  673.       pl[p].cx:=cxorig;
  674.       pl[p].cy:=cyorig;
  675.     end;
  676.   DrawSetUp;                {redraw screen}
  677. end;
  678.  
  679. Procedure MakePlanet;       {make a planet given center and radius}
  680. var c : char;
  681.     i,p,jump : integer;
  682.     x,y,xold,yold : longint;
  683.     moveit,legal : boolean;
  684. begin
  685.   ClearDialogBox;
  686.   if np=9 then       {too many planets already!}
  687.     begin
  688.       OutTextXY(0,0,'Can not make any more planets!');
  689.       delay(2000);
  690.       exit;
  691.     end;
  692.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  693.   OutTextXY(0,10,'Enter to place center, + and - to change size of jumps.');
  694.   jump:=30;
  695.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  696.   Repeat   {loop until a legal center is picked or Esc}
  697.     Repeat
  698.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  699.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  700.       moveit:=false; xold:=x; yold:=y;
  701.       InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  702.       if moveit then
  703.         begin
  704.           PutImage(xold,yold,pointr.imagepointr^,XORPut);
  705.           PutImage(x,y,pointr.imagepointr^,XORPut);
  706.           moveit:=false;
  707.         end;
  708.     Until (c=Return) or (c=Esc);
  709.     if c=Esc then exit;
  710.     legal:=true;
  711.     for i:=1 to np do    {any collisions with planets?}
  712.       if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[i].r+2*bhr then
  713.         legal:=false;
  714.     for i:=1 to 2 do     {any collisions with ships?}
  715.       if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
  716.               sqr(y-ship[i].imagey-ship[i].coffy))<=ship[i].r+bhr
  717.          then legal:=false;
  718.     if not legal then                    {uh oh!}
  719.       begin
  720.         SetPalette(Black,White);
  721.         SetFillStyle(SolidFill,Black);
  722.         Bar(0,20,screen.ex,screen.sy-2);
  723.         delay(100);
  724.         SetPalette(Black,Black);
  725.         SetColor(LightGray);
  726.         OutTextXY(0,20,'Illegal planet center!');
  727.       end;
  728.   Until legal;
  729.   p:=np+1; pl[p].cx:=x; pl[p].cy:=y;   {ok, store the info}
  730.   ClearDialogBox;
  731.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  732.   OutTextXY(0,10,'Enter to radius, + and - change size of jumps.');
  733.   jump:=30;
  734.   Repeat     {loop until a legal radius is entered or Esc}
  735.     Repeat
  736.       Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  737.                                (c='+') or (c='-') or (c=Return) or (c=Esc);
  738.       moveit:=false; xold:=x; yold:=y;
  739.       InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  740.       if moveit then
  741.         begin
  742.           PutImage(xold,yold,pointr.imagepointr^,XORPut);
  743.           PutImage(x,y,pointr.imagepointr^,XORPut);
  744.           moveit:=false;
  745.         end;
  746.     Until (c=Return) or (c=Esc);
  747.     if c=Esc then exit;
  748.     legal:=true;
  749.     pl[p].r:=round(sqrt(sqr(x-pl[p].cx)+sqr(y-pl[p].cy))); {find radius}
  750.     for i:=1 to np do    {planet collisions?}
  751.       if sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy))<=pl[p].r+pl[i].r+2*bhr then
  752.         legal:=false;
  753.     for i:=1 to 2 do     {ship collisions?}
  754.       if sqrt(sqr(x-ship[i].imagex-ship[i].coffx)+
  755.               sqr(y-ship[i].imagey-ship[i].coffy))<=pl[p].r+ship[i].r+bhr
  756.          then legal:=false;
  757.     if not legal then    {oh no!}
  758.       begin
  759.         SetPalette(Black,White);
  760.         SetFillStyle(SolidFill,Black);
  761.         Bar(0,20,screen.ex,screen.sy-2);
  762.         delay(100);
  763.         SetPalette(Black,Black);
  764.         SetColor(LightGray);
  765.         OutTextXY(0,20,'Illegal planet radius!');
  766.       end;
  767.   Until legal;
  768.   PutImage(x,y,pointr.imagepointr^,XORPut); {kill the pointer}
  769.   Inc(np);    {actually add the new planet info}
  770.   pl[p].d:=1.0; pl[p].GM:=G*2*pi*sqr(pl[p].r)*1.0; {initialize it}
  771.   SetColor(color[1]);                      {draw it}
  772.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  773.   SetFillStyle(SolidFill,color[1]);
  774.   FloodFill(pl[p].cx,pl[p].cy,color[1]);
  775. end;
  776.  
  777. Procedure ChangePlanet;   {change density [color] of a planet}
  778. var c : char;               {will not change black holes}
  779.     i,p,jump : integer;
  780.     x,y,xold,yold,minr,t : longint;
  781.     moveit,legal : boolean;
  782. begin
  783.   ClearDialogBox;
  784.   legal:=false;
  785.   if np>0 then             {see if any non-black holes exist}
  786.     for i:=1 to np do
  787.       if pl[i].r<>0 then legal:=true;
  788.   if (np=0) or (not legal) then   {sorry!}
  789.     begin
  790.       OutTextXY(0,0,'No planets to change!');
  791.       delay(2000);
  792.       exit;
  793.     end;
  794.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  795.   OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
  796.   jump:=30;
  797.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  798.   Repeat   {repeat until RETURN or Esc}
  799.     Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  800.                              (c='+') or (c='-') or (c=Return) or (c=Esc);
  801.     moveit:=false; xold:=x; yold:=y;
  802.     InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  803.     if moveit then
  804.       begin
  805.         PutImage(xold,yold,pointr.imagepointr^,XORPut);
  806.         PutImage(x,y,pointr.imagepointr^,XORPut);
  807.         moveit:=false;
  808.       end;
  809.   Until (c=Return) or (c=Esc);
  810.   PutImage(x,y,pointr.imagepointr^,XORPut);  {kill the pointer}
  811.   if c=Esc then exit;
  812.   p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
  813.   for i:=1 to np do   {find closest non-black hole planet}
  814.     begin
  815.       t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
  816.       if (t<minr) and (pl[i].r<>0) then begin minr:=t; p:=i; end;
  817.     end;
  818.   ClearDialogBox;
  819.   OutTextXY(0, 0,'Change to: 1. Red   2. Green   3. Blue    Esc aborts');
  820.   OutTextXY(0,10,'Option: ');    {get a density}
  821.   Repeat c:=ReadKey; Until (c='1') or (c='2') or (c='3') or (c=Esc);
  822.   if c=Esc then exit;
  823.   i:=Ord(c)-48;
  824.   pl[p].d:=(i+1)/2.0;       {new density}
  825.   SetColor(color[i]);       {redraw}
  826.   Circle(pl[p].cx,pl[p].cy,pl[p].r);
  827.   SetFillStyle(SolidFill,color[i]);
  828.   FloodFill(pl[p].cx,pl[p].cy,color[i]);
  829. end;
  830.  
  831. Procedure DeletePlanet;   {kill a planet/black hole}
  832. var c : char;
  833.     i,p,jump : integer;
  834.     x,y,xold,yold,minr,t : longint;
  835.     moveit : boolean;
  836. begin
  837.   ClearDialogBox;
  838.   if np=0 then    {nobody there!}
  839.     begin
  840.       OutTextXY(0,0,'No planets to delete!');
  841.       delay(2000);
  842.       exit;
  843.     end;
  844.   OutTextXY(0, 0,'Use cursors to move pointer. (Num Lock on)   Esc aborts');
  845.   OutTextXY(0,10,'Enter to pick planet, + and - to change size of jumps.');
  846.   jump:=30;
  847.   x:=100; y:=100; PutImage(x,y,pointr.imagepointr^,XORPut);
  848.   Repeat
  849.     Repeat c:=ReadKey; Until (c='4') or (c='8') or (c='6') or (c='2') or
  850.                              (c='+') or (c='-') or (c=Return) or (c=Esc);
  851.     moveit:=false; xold:=x; yold:=y;
  852.     InterpKey(c,x,y,pointr.coffx,pointr.coffy,pointr.r,jump,moveit);
  853.     if moveit then
  854.       begin
  855.         PutImage(xold,yold,pointr.imagepointr^,XORPut);
  856.         PutImage(x,y,pointr.imagepointr^,XORPut);
  857.         moveit:=false;
  858.       end;
  859.   Until (c=Return) or (c=Esc);
  860.   PutImage(x,y,pointr.imagepointr^,XORPut);
  861.   if c=Esc then exit;
  862.   p:=0; minr:=trunc(sqrt(sqr(screen.lx)+sqr(screen.ly)));
  863.   for i:=1 to np do  {find the closest planet/black hole}
  864.     begin
  865.       t:=trunc(sqrt(sqr(x-pl[i].cx)+sqr(y-pl[i].cy)));
  866.       if t<minr then begin minr:=t; p:=i; end;
  867.     end;
  868.   if p<9 then           {move everybody above the one deleted one down}
  869.     for i:=p to np-1 do
  870.       pl[i]:=pl[i+1];
  871.   Dec(np);         {delete}
  872.   DrawSetup;       {redraw}
  873. end;
  874.  
  875. Procedure Changes;   {changes menu}
  876. var option : char;
  877. begin
  878.   Repeat
  879.     ClearDialogBox;
  880.     SetColor(LightGray);
  881.     OutTextXY(0, 0,'1. Move ship       2. Move planet    3. Make planet');
  882.     OutTextXY(0,10,'4. Change planet   5. Delete planet     Esc quits menu');
  883.     OutTextXY(0,20,'Option: ');
  884.     option:=ReadKey;
  885.     Case option of
  886.       '1' : MoveShip;
  887.       '2' : MovePlanet;
  888.       '3' : MakePlanet;
  889.       '4' : ChangePlanet;
  890.       '5' : DeletePlanet;
  891.     end;
  892.   Until option=Esc;
  893. end;
  894.  
  895. Procedure MainMenu;   {main menu}
  896. var option : char;
  897. begin
  898.   Repeat
  899.     ClearDialogBox;
  900.     SetColor(LightGray);
  901.     OutTextXY(0,0,'1. Playing the game   2. Options   3. Changes   4. Quit');
  902.     OutTextXY(0,10,'Option: ');
  903.     option:=ReadKey;
  904.     Case option of
  905.       '1' : PlayingtheGame;
  906.       '2' : Options;
  907.       '3' : Changes;
  908.     end;
  909.   Until option='4';
  910. end;
  911.  
  912. Procedure Title;   {title screen and credits}
  913. begin
  914.   SetTextStyle(SansSerifFont,HorizDir,9);
  915.   OutTextXY(25,100,'Gravity Wars');
  916.   SetTextStyle(SansSerifFont,HorizDir,2);
  917.   OutTextXY(300,300,'by Sohrab Ismail-Beigi');
  918.   OutTextXY(300,350,'update by Arthur R. Hicken');
  919.   delay(3000);
  920.   SetTextStyle(DefaultFont,HorizDir,0);
  921. end;
  922.  
  923. BEGIN
  924.   Init;
  925.   Title;
  926.   RandomSetup;
  927.   DrawSetup;
  928.   MainMenu;
  929.   Finish;
  930. END.
  931.